;;;;;; compiler.scm - Scheme Compiler module.    -*- Mode: Scheme -*-
;;;;;; Author: Erik Silkensen <silkense@colorado.edu>
;;;;;; Version: 12 Aug 2009

#lang scheme

(require srfi/13)           ; provides String Libraries
(require "constants.scm")
(require "attributes.scm")
(require "class-file.scm")
(require "parser.scm")
(require "syntax-expander.scm")
(require "code-generator.scm")

;;; To compile a Scheme file with this program, use the following command:
;;;     mzscheme -t compiler.scm -m <file.scm>

(provide compile main)

(define (compile file args)
  ;; Compile a Scheme program into a Java class. File is a string filename
  ;; of the Scheme program to compile.
  (let* ((base (file-name->class-name file))
         (cf (make-module base)))
    ((cf 'add-attribute!) (make-source-file-attribute file (cf 'pool)))
    (with-input-from-file file
      (lambda () (cg cf (expand (parse) (member "-v" args)))))
    (with-output-to-file (string-append base ".class")
      (lambda () ((cf 'write)) #t)
      #:exists 'replace)))

(define (make-module name)
  ;; Create a Scheme module. Name is the name of the module. A module is a
  ;; Class File object that extends the *module-class*. A constructure is
  ;; provided for the new module, in addition to the static class
  ;; initializer. The class initializer calls a static method ``init'' that
  ;; the module must later create and implement itself.
  (let ((super-class *module-class*))
    (let ((cf (make-class-file name super-class))
          (init-type (string-append "(III" *env-type* ")V")))
      ((cf 'add-field!)
       *global-env*
       *env-type*
       (bitwise-ior ACC-PRIVATE ACC-STATIC ACC-FINAL))
      (let ((<init> ((cf 'add-method) "<init>" init-type ACC-PUBLIC)))
        (aload 0 <init>)
        (iload 1 <init>)
        (iload 2 <init>)
        (iload 3 <init>)
        (aload 4 <init>)
        (invokespecial super-class "<init>" init-type <init>)
        (return <init>))
      (let ((<clinit> ((cf 'add-method) "<clinit>" "()V" ACC-STATIC))
            (env-init-type (string-append "(" *env-type* ")V")))
        (new-class *env-class* <clinit>)
        (dup <clinit>)
        (getstatic *env-class* "DEFAULT" *env-type* <clinit>)
        (invokespecial *env-class* "<init>" env-init-type <clinit>)
        (putstatic name *global-env* *env-type* <clinit>)
        (invokestatic name "init" "()V" <clinit>)
        (return <clinit>))
      cf)))

(define (file-name->class-name file)
  (substring file 0 (string-index file #\.)))

(define (main . args)
  (compile (car args) (cdr args))
  (void))
   
              
